home *** CD-ROM | disk | FTP | other *** search
/ SGI Developer Toolbox 6.1 / SGI Developer Toolbox 6.1 - Disc 4.iso / lib / mathlib / libblas / src_original / lsame.f < prev    next >
Encoding:
Text File  |  1994-08-02  |  2.4 KB  |  99 lines
  1.       LOGICAL          FUNCTION LSAME( CA, CB )
  2. *
  3. *  -- LAPACK auxiliary routine --
  4. *     Argonne National Laboratory
  5. *     October 11, 1988
  6. *
  7. *     .. Scalar Arguments ..
  8.       CHARACTER          CA, CB
  9. *     ..
  10. *
  11. *  Purpose
  12. *  =======
  13. *
  14. *     LSAME returns .TRUE. if CA is the same letter as CB regardless
  15. *     of case.
  16. *
  17. *  N.B. This version of the routine is only correct for ASCII code.
  18. *       Installers must modify the routine for other character-codes.
  19. *
  20. *       For EBCDIC systems the constant IOFF must be changed to -64.
  21. *       For CDC systems using 6-12 bit representations, the system-
  22. *       specific code in comments must be activated.
  23. *
  24. *  Arguments
  25. *  =========
  26. *
  27. *  CA     - CHARACTER*1
  28. *  CB     - CHARACTER*1
  29. *           On entry, CA and CB specify characters to be compared.
  30. *           Unchanged on exit.
  31. *
  32. *  Auxiliary routine for Level 2 Blas.
  33. *
  34. *  -- Written on 20-July-1986
  35. *     Richard Hanson, Sandia National Labs.
  36. *     Jeremy Du Croz, Nag Central Office.
  37. *
  38. *
  39. *     .. Parameters ..
  40.       INTEGER            IOFF
  41.       PARAMETER        ( IOFF = 32 )
  42. *     ..
  43. *     .. Intrinsic Functions ..
  44.       INTRINSIC          ICHAR
  45. *     ..
  46. *     .. Executable Statements ..
  47. *
  48. *     Test if the characters are equal
  49. *
  50.       LSAME = CA.EQ.CB
  51. *
  52. *     Now test for equivalence
  53. *
  54.       IF( .NOT.LSAME ) THEN
  55.          LSAME = ICHAR( CA ) - IOFF.EQ.ICHAR( CB )
  56.       END IF
  57.       IF( .NOT.LSAME ) THEN
  58.          LSAME = ICHAR( CA ).EQ.ICHAR( CB ) - IOFF
  59.       END IF
  60. *
  61.       RETURN
  62. *
  63. *  The following comments contain code for CDC systems using 6-12 bit
  64. *  representations.
  65. *
  66. *     .. Parameters ..
  67. *     INTEGER            ICIRFX
  68. *     PARAMETER        ( ICIRFX=62 )
  69. *     .. Scalar arguments ..
  70. *     CHARACTER*1        CB
  71. *     .. Array arguments ..
  72. *     CHARACTER*1        CA(*)
  73. *     .. Local scalars ..
  74. *     INTEGER            IVAL
  75. *     .. Intrinsic functions ..
  76. *     INTRINSIC          ICHAR, CHAR
  77. *     .. Executable statements ..
  78. *
  79. *     See if the first character in string CA equals string CB.
  80. *
  81. *     LSAME = CA(1) .EQ. CB .AND. CA(1) .NE. CHAR(ICIRFX)
  82. *
  83. *     IF (LSAME) RETURN
  84. *
  85. *     The characters are not identical. Now check them for equivalence.
  86. *     Look for the 'escape' character, circumflex, followed by the
  87. *     letter.
  88. *
  89. *     IVAL = ICHAR(CA(2))
  90. *     IF (IVAL.GE.ICHAR('A') .AND. IVAL.LE.ICHAR('Z')) THEN
  91. *        LSAME = CA(1) .EQ. CHAR(ICIRFX) .AND. CA(2) .EQ. CB
  92. *     END IF
  93. *
  94. *     RETURN
  95. *
  96. *     End of LSAME.
  97. *
  98.       END
  99.